home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / pcl4p40.arj / XYMODEM.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-09  |  11KB  |  362 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*  This program is donated to the Public    *)
  4. (*  Domain by MarshallSoft Computing, Inc.   *)
  5. (*  It is provided as an example of the use  *)
  6. (*  of the Personal Communications Library.  *)
  7. (*                                           *)
  8. (*********************************************)
  9.  
  10. { $DEFINE DEBUG}
  11. {$I DEFINES.PAS}
  12.  
  13.  
  14. unit xymodem;
  15.  
  16. interface
  17.  
  18. uses xypacket,term_io,PCL4P,crt;
  19.  
  20. function TxyModem(
  21.          Port     : Integer;     (* COM port [0..3] *)
  22.      Var Filename : String20;    (* filename buffer *)
  23.      Var Buffer   : BufferType;  (* 1024 byte data buffer *)
  24.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  25.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  26.        : Boolean;
  27.  
  28. function RxyModem(
  29.          Port     : Integer;        (* COM port [0..3] *)
  30.      Var Filename : String20;       (* filename buffer *)
  31.      Var Buffer   : BufferType;     (* 1024 byte data buffer *)
  32.          NCGbyte  : Byte;           (* NAK, 'C', or 'G' *)
  33.          BatchFlag: Boolean)        (* if TRUE, get filename from packet 0 *)
  34.        : Boolean;
  35.  
  36. implementation
  37.  
  38. Const NAK = $15;
  39.       CAN = $18;
  40.  
  41. function TxyModem(
  42.          Port     : Integer;     (* COM port [0..3] *)
  43.      Var Filename : String20;    (* filename buffer *)
  44.      Var Buffer   : BufferType;  (* 1024 byte data buffer *)
  45.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  46.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  47.        : Boolean;
  48. Label 999;
  49. Var
  50.   i, k   : Integer;
  51.   Code   : Integer;
  52.   Flag   : Boolean;
  53.   Handle : File;
  54.   c      : Char;
  55.   Packet     : Integer;
  56.   PacketType : Char;
  57.   PacketNbr  : Byte;
  58.   BlockSize  : Word;
  59.   ReadSize   : Word;
  60.   FirstPacket: Word;
  61.   EOTflag  : Boolean;
  62.   CheckSum : Word;
  63.   Number1K : Word;       (* total # 1K ( 8 records ) packets *)
  64.   Number128 : Word;      (* total # 128 byte ( 1 record ) packets *)
  65.   NCGbyte : Byte;
  66.   FileBytes : LongInt;
  67.   RemainingBytes : LongInt;
  68.   EmptyFlag : Boolean;
  69.   Message  : String40;
  70.   Temp1 : String20;
  71.   Temp2 : String20;
  72.   Result : Word;
  73. begin
  74.  (* begin *)
  75.  Number128 := 0;
  76.  Number1K := 0;
  77.  NCGbyte := NAK;
  78.  EmptyFlag := FALSE;
  79.  EOTflag := FALSE;
  80.  if BatchFlag then
  81.    begin
  82.      if (Length(Filename)=0) then EmptyFlag := TRUE;
  83.    end;
  84.  if not EmptyFlag then
  85.    begin (* not EmptyFlag *)
  86.      (*EmptyFlag := FALSE;*)
  87. {$I-}
  88.      Assign(Handle,Filename);
  89.      Reset(Handle,1);
  90. {$I+}
  91.      if IOResult <> 0 then
  92.        begin
  93.          Message := 'Cannot open ' + Filename;
  94.          WriteMsg(Message,1);
  95.          TxyModem := FALSE;
  96.          goto 999;
  97.        end;
  98.    end; (* not EmptyFlag *)
  99.  WriteMsg('XYMODEM send: waiting for receiver ',1);
  100.  (* compute # blocks *)
  101.  if EmptyFlag then
  102.    begin (* empty file *)
  103.      Number128 := 0;
  104.      Number1K := 0
  105.    end
  106.  else
  107.    begin (* file not empty *)
  108.      FileBytes := FileSize(Handle);
  109.      RemainingBytes := FileBytes;
  110.      if OneKflag
  111.        then Number1K := FileBytes div 1024
  112.        else Number1K := 0;
  113.      Number128 := 1 + (FileBytes - 1 - 1024 * Number1K) div 128;
  114.      Str(Number1K,Temp1);
  115.      Str(Number128,Temp2);
  116.      Message := Temp1+' 1K & '+Temp2+' 128-byte packets';
  117.      WriteMsg(Message,1);
  118.    end;
  119.  (* clear comm port [there may be several NAKs queued up] *)
  120.  Code := SioRxFlush(Port);
  121.  (* get receivers start up NAK or 'C' *)
  122.  if not TxStartup(Port,NCGbyte) then
  123.    begin
  124.      TxyModem := FALSE;
  125.      goto 999;
  126.    end;
  127.  (* loop over all packets *)
  128.  if BatchFlag
  129.    then FirstPacket := 0
  130.    else FirstPacket := 1;
  131.  (* transmit each packet in turn *)
  132.  for Packet := FirstPacket to Number1K+Number128 do
  133.    begin
  134.       (* user aborts ? *)
  135.       if KeyPressed then if (Ord(ReadKey) = CAN) then
  136.         begin
  137.            TxCAN(Port);
  138.            WriteMsg('*** Canceled by USER ***',1);
  139.            TxyModem := FALSE;
  140.            goto 999
  141.         end;
  142.      (* issue message *)
  143.      str(Packet,Temp1);
  144.      Message := 'Packet ' + Temp1;
  145.      WriteMsg(Message,1);
  146.      (* load up Buffer *)
  147.      if Packet=0 then
  148.        begin (* packet = 0 *)
  149.          if EmptyFlag then Buffer[0] := 0
  150.          else
  151.            begin (* not empty *)
  152.              (* copy filename to buffer *)
  153.              BlockSize := 128;
  154.              k := 0;
  155.              for i:= 1 to Length(Filename) do
  156.                begin
  157.                  Buffer[k] := ord(Filename[i]);
  158.                  k := k + 1;
  159.                end;
  160.              Buffer[k] := 0;
  161.              (* copy file length to buffer *)
  162.              k := k + 1;
  163.              Str(FileBytes,Temp1);
  164.              for i := 1 to Length(Temp1) do
  165.                begin
  166.                  Buffer[k] := ord(Temp1[i]);
  167.                  k := k + 1;
  168.                end;
  169.              (* pad remainder of buffer *)
  170.              for i := k to 127 do Buffer[i] := 0;
  171.            end (* not empty *)
  172.         end (* Packet = 0 *)
  173.       else
  174.         begin  (* Packet > 0 *)
  175.           (* DATA Packet: use 1K or 128-byte blocks ? *)
  176.           if BatchFlag and (Packet <= Number1K)
  177.             then BlockSize := 1024
  178.             else BlockSize := 128;
  179.           (* compute # bytes to read *)
  180.           if RemainingBytes < BlockSize then ReadSize := RemainingBytes
  181.           else ReadSize := BlockSize;
  182.           (* read next block from disk *)
  183.           BlockRead(Handle,Buffer,ReadSize,Result);
  184.           RemainingBytes := RemainingBytes - Result;
  185.           if Result <> ReadSize then
  186.             begin
  187.               WriteMsg('Unexpected EOF on disk read',1);
  188.               TxyModem := FALSE;
  189.               goto 999;
  190.             end;
  191.           (* pad short buffer with ^Z *)
  192.           if ReadSize < BlockSize then
  193.             for i:= ReadSize to Blocksize do Buffer[i] := $1A;
  194.         end; (* Packet > 0 *)
  195.      (* send this packet *)
  196.      if not TxPacket(Port,Packet,BlockSize,Buffer,NCGbyte) then
  197.        begin
  198.          TxyModem := FALSE;
  199.          goto 999
  200.        end;
  201.      Code := SioDelay(5);
  202.      (* must 'restart' after non null packet 0 *)
  203.      if (not EmptyFlag) and (Packet=0) then Flag := TxStartup(Port,NCGbyte);
  204.    end; (* end -- for(Packet) *)
  205.  (* done if empty packet 0 *)
  206.  if EmptyFlag then
  207.    begin
  208.      WriteMsg('Batch transfer completed',1);
  209.      TxyModem := TRUE;
  210.      goto 999;
  211.    end;
  212.  (* all done. send EOT up to 10 times *)
  213.  close(Handle);
  214.  if not TxEOT(Port) then
  215.    begin
  216.      SayError(Port,'EOT not acknowledged');
  217.      TxyModem := FALSE;
  218.      goto 999;
  219.    end;
  220.  WriteMsg('Transfer completed',1);
  221.  TxyModem := TRUE;
  222. 999: end; (* end -- TxyModem *)
  223.  
  224. function RxyModem(
  225.          Port     : Integer;        (* COM port [0..3] *)
  226.      Var Filename : String20;       (* filename buffer *)
  227.      Var Buffer   : BufferType;     (* 1024 byte data buffer *)
  228.          NCGbyte  : Byte;           (* NAK, 'C', or 'G' *)
  229.          BatchFlag: Boolean)        (* get filename from packet 0 *)
  230.        : Boolean;
  231. Label 999;
  232. Var
  233.   i, k    : Integer;
  234.   Handle  : File;         (* file Handle *)
  235.   Packet  : Integer;      (* packet index *)
  236.   Code    : Integer;      (* return code *)
  237.   Flag    : Boolean;
  238.   EOTflag : Boolean;
  239.   Message : String40;
  240.   Temp    : String40;
  241.   Result  : Integer;
  242.   FirstPacket: Word;
  243.   PacketNbr  : Byte;
  244.   FileBytes  : LongInt;
  245.   EmptyFlag  : Boolean;
  246.   BufferSize : Word;
  247.   (* begin *)
  248. begin
  249.   EmptyFlag := FALSE;
  250.   EOTflag := FALSE;
  251.   WriteMsg('XYMODEM Receive: Waiting for Sender ',1);
  252.   (* clear comm port *)
  253.   Code := SioRxFlush(Port);
  254.   (* Send NAKs or 'C's *)
  255.   if not RxStartup(Port,NCGbyte) then
  256.     begin
  257.       RxyModem := FALSE;
  258.       goto 999;
  259.     end;
  260.   (* open file unless BatchFlag is on *)
  261.   if BatchFlag then FirstPacket := 0
  262.   else
  263.     begin (* not BatchFlag *)
  264.       FirstPacket := 1;
  265.       (* open Filename for write *)
  266. {$I-}
  267.       Assign(Handle,Filename);
  268.       Rewrite(Handle,1);
  269. {$I+}
  270.       if IOResult <> 0 then
  271.         begin
  272.           Message := 'Cannot open ' + Filename;
  273.           WriteMsg(Message,1);
  274.           RxyModem := FALSE;
  275.           goto 999;
  276.         end;
  277.     end; (* not BatchFlag *)
  278.   (* get each packet in turn *)
  279.   for Packet := FirstPacket to MaxInt do
  280.     begin
  281.       (* user aborts ? *)
  282.       if KeyPressed then if (Ord(ReadKey) = CAN) then
  283.         begin
  284.            TxCAN(Port);
  285.            WriteMsg('*** Canceled by USER ***',1);
  286.            RxyModem := FALSE;
  287.            goto 999
  288.         end;
  289.       (* issue message *)
  290.       str(Packet,Temp);
  291.       Message := 'Packet ' + Temp;
  292.       WriteMsg(Message,1);
  293.       PacketNbr := Packet AND $00ff;
  294.       (* get next packet *)
  295.       if not RxPacket(Port,Packet,BufferSize,Buffer,NCGbyte,EOTflag) then
  296.         begin
  297.           RxyModem := FALSE;
  298.           goto 999;
  299.         end;
  300.       (* packet 0 ? *)
  301.       if Packet = 0 then
  302.         begin (* Packet = 0 *)
  303.           if Buffer[0] = 0 then
  304.             begin
  305.               WriteMsg('Batch transfer complete',1);
  306.               RxyModem := TRUE;
  307.               goto 999;
  308.             end;
  309.           (* get filename *)
  310.           i := 0;
  311.           k := 1;
  312.           repeat
  313.             Filename[k] := chr(Buffer[i]);
  314.             i := i + 1;
  315.             k := k + 1;
  316.           until Buffer[i] = 0;
  317.           FileName[0] := chr(i);
  318.           (* get file size *)
  319.           i := i + 1;
  320.           k := 1;
  321.           repeat
  322.             Temp[k] := chr(Buffer[i]);
  323.             i := i + 1;
  324.             k := k + 1;
  325.           until Buffer[i] = 0;
  326.           Temp[0] := chr(k - 1);
  327.           Val(Temp,FileBytes,Result);
  328.        end; (* Packet = 0 *)
  329.     (* all done if EOT was received *)
  330.     if EOTflag then
  331.       begin
  332.         close(Handle);
  333.         WriteMsg('Transfer completed',1);
  334.         RxyModem := TRUE;
  335.         goto 999
  336.       end;
  337.     (* process the packet *)
  338.     if Packet = 0 then
  339.       begin
  340.         (* open file using filename in packet 0 *)
  341. {$I-}
  342.         Assign(Handle,Filename);
  343.         Rewrite(Handle,1);
  344. {$I+}
  345.         if IOResult <> 0 then
  346.           begin
  347.             Message := 'Cannot open ' + Filename;
  348.             WriteMsg(Message,1);
  349.             RxyModem := FALSE;
  350.             goto 999;
  351.           end;
  352.         (* must 'restart' after packet 0 *)
  353.         Flag := RxStartup(Port,NCGbyte);
  354.       end
  355.     else (* Packet > 0 [DATA packet] *)
  356.       begin (* write Buffer *)
  357.         BlockWrite(Handle,Buffer,BufferSize)
  358.       end (* end -- else *)
  359.   end; (* end -- for(Packet) *)
  360. 999:end; (* end - RxyModem *)
  361.  
  362. end.